home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tests / file.test < prev    next >
Text File  |  1992-12-23  |  12KB  |  328 lines
  1. # Commands covered:  file
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /rel/cvsfiles/devo/tcl/tests/file.test,v 1.1.1.1 1992/11/07 04:46:55 zoo Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. # rootname and ext
  21.  
  22. test file-1.1 {rootname and extension options} {file ext abc.def} .def
  23. test file-1.2 {rootname and extension options} {file ro abc.def} abc
  24. test file-1.3 {rootname and extension options} {file extension a/b/c.d} .d
  25. test file-1.4 {rootname and extension options} {file rootname a/b/c.d} a/b/c
  26. test file-1.5 {rootname and extension options} {file extension a/b.c/d} {}
  27. test file-1.6 {rootname and extension options} {file rootname a/b.c/d} a/b.c/d
  28. set num 7
  29. foreach outer { {} a .a a. a.a } {
  30.   foreach inner { {} a .a a. a.a } {
  31.     set thing [format %s/%s $outer $inner]
  32.     test file-1.$num {rootname and extension options} {
  33.     format %s%s [file rootname $thing] [file ext $thing]
  34.     } $thing
  35.     set num [expr $num+1]
  36.   }
  37. }
  38.  
  39. # dirname and tail
  40.  
  41. test file-2.1 {dirname and tail options} {file dirname .def} .
  42. test file-2.2 {dirname and tail options} {file tail abc.def} abc.def
  43. test file-2.3 {dirname and tail options} {file d a/b/c.d} a/b
  44. test file-2.4 {dirname and tail options} {file ta a/b/c.d} c.d
  45. test file-2.5 {dirname and tail options} {file dirname a/b.c/d} a/b.c
  46. test file-2.6 {dirname and tail options} {file tail a/b.c/d} d
  47. set num 7
  48. foreach outer { a .a a. a.a } {
  49.   foreach inner { {} a .a a. a.a } {
  50.     set thing [format %s/%s $outer $inner]
  51.     test file-2.$num {dirname and tail options} {
  52.     format %s/%s [file dirname $thing] [file tail $thing]
  53.     } $thing
  54.     set num [expr $num+1]
  55.   }
  56. }
  57.  
  58. # exists
  59.  
  60. catch {exec chmod 777 dir.file}
  61. catch {exec rm -f dir.file/gorp.file}
  62. catch {exec rm -f gorp.file}
  63. catch {exec rmdir dir.file}
  64. catch {exec rm -f link.file}
  65. test file-3.1 {exists option} {file exists gorp.file} 0
  66. test file-3.2 {exists option} {file exists dir.file/gorp.file} 0
  67. exec cat > gorp.file << abcde
  68. exec mkdir dir.file
  69. exec cat > dir.file/gorp.file << 12345
  70. test file-3.3 {exists option} {file exists gorp.file} 1
  71. test file-3.4 {exists option} {file exi dir.file/gorp.file} 1
  72.  
  73. # The test below has to be done in /tmp rather than the current
  74. # directory in order to guarantee (?) a local file system:  some
  75. # NFS file systems won't do the stuff below correctly.
  76.  
  77. catch {exec rm /tmp/tcl.foo.dir/file}
  78. catch {exec rmdir /tmp/tcl.foo.dir}
  79. exec mkdir /tmp/tcl.foo.dir
  80. exec cat > /tmp/tcl.foo.dir/file << 12345
  81. exec chmod 000 /tmp/tcl.foo.dir
  82. if {$user != "root"} {
  83.     test file-3.5 {exists option} {file exists /tmp/tcl.foo.dir/file} 0
  84. }
  85. exec chmod 775 /tmp/tcl.foo.dir
  86. exec rm /tmp/tcl.foo.dir/file
  87. exec rmdir /tmp/tcl.foo.dir
  88.  
  89. # executable
  90.  
  91. exec chmod 000 dir.file
  92. if {$user != "root"} {
  93.     test file-4.1 {executable option} {file executable gorp.file} 0
  94. }
  95. exec chmod 775 gorp.file
  96. test file-4.2 {executable option} {file exe gorp.file} 1
  97.  
  98. # isdirectory
  99.  
  100. test file-5.1 {isdirectory option} {file isdirectory gorp.file} 0
  101. test file-5.2 {isdirectory option} {file isd dir.file} 1
  102.  
  103. # isfile
  104.  
  105. test file-6.1 {isfile option} {file isfile gorp.file} 1
  106. test file-6.2 {isfile option} {file isfile dir.file} 0
  107.  
  108. # isowned
  109.  
  110. test file-7.1 {owned option} {file owned gorp.file} 1
  111. if {$user != "root"} {
  112.     test file-7.2 {owned option} {file owned /} 0
  113. }
  114.  
  115. # readable
  116.  
  117. exec chmod 444 gorp.file
  118. test file-8.1 {readable option} {file readable gorp.file} 1
  119. exec chmod 333 gorp.file
  120. if {$user != "root"} {
  121.     test file-8.2 {readable option} {file reada gorp.file} 0
  122. }
  123.  
  124. # writable
  125.  
  126. exec chmod 555 gorp.file
  127. if {$user != "root"} {
  128.     test file-9.1 {writable option} {file writable gorp.file} 0
  129. }
  130. exec chmod 222 gorp.file
  131. test file-9.2 {writable option} {file w gorp.file} 1
  132.  
  133. # stat
  134.  
  135. exec cat > gorp.file << "Test string"
  136. exec chmod 765 gorp.file
  137. test file-10.1 {stat option} {
  138.     catch {unset stat}
  139.     file stat gorp.file stat
  140.     lsort [array names stat]
  141. } {atime ctime dev gid ino mode mtime nlink size type uid}
  142. test file-10.2 {stat option} {
  143.     catch {unset stat}
  144.     file stat gorp.file stat
  145.     list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type)
  146. } {1 11 501 file}
  147. test file-10.3 {stat option} {
  148.     string tolower [list [catch {file stat _bogus_ stat} msg] \
  149.         $msg $errorCode]
  150. } {1 {couldn't stat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  151. test file-10.4 {stat option} {
  152.     list [catch {file stat _bogus_} msg] $msg $errorCode
  153. } {1 {wrong # args: should be "file stat name varName"} NONE}
  154. test file-10.5 {stat option} {
  155.     list [catch {file stat _bogus_ a b} msg] $msg $errorCode
  156. } {1 {wrong # args: should be "file stat name varName"} NONE}
  157. test file-10.6 {stat option} {
  158.     catch {unset x}
  159.     set x 44
  160.     list [catch {file stat gorp.file x} msg] $msg $errorCode
  161. } {1 {can't set "x(dev)": variable isn't array} NONE}
  162. catch {unset stat}
  163.  
  164. # mtime, and size (I've given up trying to find a test for "atime":  there
  165. # seem to be too many quirks in the way file systems handle this to come
  166. # up with a reproducible test).
  167.  
  168. test file-11.1 {mtime and atime and size options} {
  169.     catch {unset stat}
  170.     file stat gorp.file stat
  171.     list [expr {[file mtime gorp.file] == $stat(mtime)}] \
  172.         [expr {[file atime gorp.file] == $stat(atime)}] \
  173.         [file size gorp.file]
  174. } {1 1 11}
  175. test file-11.2 {mtime option} {
  176.     set old [file mtime gorp.file]
  177.     exec sleep 2
  178.     set f [open gorp.file w]
  179.     puts $f "More text"
  180.     close $f
  181.     set new [file mtime gorp.file]
  182.     expr {($new > $old) && ($new <= ($old+5))}
  183. } {1}
  184. test file-11.3 {size option} {
  185.     set oldsize [file size gorp.file]
  186.     set f [open gorp.file a]
  187.     puts $f "More text"
  188.     close $f
  189.     expr {[file size gorp.file] - $oldsize}
  190. } {10}
  191. test file-11.4 {errors in atime option} {
  192.     list [catch {file atime _bogus_ x} msg] $msg $errorCode
  193. } {1 {wrong # args: should be "file atime name"} NONE}
  194. test file-11.5 {errors in atime option} {
  195.     string tolower [list [catch {file atime _bogus_} msg] \
  196.         $msg $errorCode]
  197. } {1 {couldn't stat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  198. test file-11.6 {errors in mtime option} {
  199.     list [catch {file mtime _bogus_ x} msg] $msg $errorCode
  200. } {1 {wrong # args: should be "file mtime name"} NONE}
  201. test file-11.7 {errors in mtime option} {
  202.     string tolower [list [catch {file mtime _bogus_} msg] $msg \
  203.         $errorCode]
  204. } {1 {couldn't stat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  205. test file-11.8 {errors in size option} {
  206.     list [catch {file size _bogus_ x} msg] $msg $errorCode
  207. } {1 {wrong # args: should be "file size name"} NONE}
  208. test file-11.9 {errors in size option} {
  209.     string tolower [list [catch {file size _bogus_} msg] $msg \
  210.         $errorCode]
  211. } {1 {couldn't stat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  212.  
  213. # type
  214.  
  215. test file-12.1 {type option} {
  216.     file type dir.file
  217. } directory
  218. test file-12.2 {type option} {
  219.     file type gorp.file
  220. } file
  221. if $atBerkeley {
  222.     exec ln -s a/b/c link.file
  223.     test file-12.3 {type option} {
  224.     file type link.file
  225.     } link
  226.     exec rm link.file
  227. }
  228. test file-12.4 {errors in type option} {
  229.     list [catch {file type a b} msg] $msg $errorCode
  230. } {1 {wrong # args: should be "file type name"} NONE}
  231. test file-12.5 {errors in type option} {
  232.     string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
  233. } {1 {couldn't stat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  234.  
  235. # lstat and readlink:  run these tests only at Berkeley, since not all
  236. # sites will have symbolic links
  237.  
  238. if $atBerkeley {
  239.     exec ln -s gorp.file link.file
  240.     test file-13.1 {lstat option} {
  241.     catch {unset stat}
  242.     file lstat link.file stat
  243.     lsort [array names stat]
  244.     } {atime ctime dev gid ino mode mtime nlink size type uid}
  245.     test file-13.1 {lstat option} {
  246.     catch {unset stat}
  247.     file lstat link.file stat
  248.     list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
  249.     } {1 511 link}
  250.     test file-13.3 {errors in lstat option} {
  251.     string tolower [list [catch {file lstat _bogus_ stat} msg] \
  252.         $msg $errorCode]
  253.     } {1 {couldn't lstat "_bogus_": no such file or directory} {unix enoent {no such file or directory}}}
  254.     test file-13.4 {errors in lstat option} {
  255.     list [catch {file lstat _bogus_} msg] $msg $errorCode
  256.     } {1 {wrong # args: should be "file lstat name varName"} NONE}
  257.     test file-13.5 {errors in lstat option} {
  258.     list [catch {file lstat _bogus_ a b} msg] $msg $errorCode
  259.     } {1 {wrong # args: should be "file lstat name varName"} NONE}
  260.     test file-13.6 {errors in lstat option} {
  261.     catch {unset x}
  262.     set x 44
  263.     list [catch {file lstat gorp.file x} msg] $msg $errorCode
  264.     } {1 {can't set "x(dev)": variable isn't array} NONE}
  265.     catch {unset stat}
  266.  
  267.     test file-14.1 {readlink option} {
  268.     file readlink link.file
  269.     } gorp.file
  270.     test file-14.2 {errors in readlink option} {
  271.     list [catch {file readlink a b} msg] $msg $errorCode
  272.     } {1 {wrong # args: should be "file readlink name"} NONE}
  273.     test file-14.3 {errors in readlink option} {
  274.     list [catch {file readlink _bogus_} msg] $msg $errorCode
  275.     } {1 {couldn't readlink "_bogus_": no such file or directory} {UNIX ENOENT {no such file or directory}}}
  276.  
  277.     exec rm link.file
  278. }
  279.  
  280. # Error conditions
  281.  
  282. test file-15.1 {error conditions} {
  283.     list [catch file msg] $msg
  284. } {1 {wrong # args: should be "file option name ?arg ...?"}}
  285. test file-15.2 {error conditions} {
  286.     list [catch {file x} msg] $msg
  287. } {1 {wrong # args: should be "file option name ?arg ...?"}}
  288. test file-15.3 {error conditions} {
  289.     list [catch {file exists x too} msg] $msg
  290. } {1 {wrong # args: should be "file exists name"}}
  291.  
  292. # Compute error message to use for bad options (depends on whether or
  293. # not symbolic links are supported).
  294.  
  295. catch {file badcommand x} msg
  296. if [string match *readlink* $msg] {
  297.     set errMsg "should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable"
  298. } else {
  299.     set errMsg "should be atime, dirname, executable, exists, extension, isd
  300. irectory, isfile, lstat, mtime, owned, readable, root, size, stat, tail, type, o
  301. r writable"
  302. }
  303. test file-15.4 {error conditions} {
  304.     list [catch {file gorp x} msg] $msg
  305. } [format {1 {bad option "gorp": %s}} $errMsg]
  306. test file-15.5 {error conditions} {
  307.     list [catch {file ex x} msg] $msg
  308. } [format {1 {bad option "ex": %s}} $errMsg]
  309. test file-15.6 {error conditions} {
  310.     list [catch {file is x} msg] $msg
  311. } [format {1 {bad option "is": %s}} $errMsg]
  312. test file-15.7 {error conditions} {
  313.     list [catch {file read x} msg] $msg
  314. } [format {1 {bad option "read": %s}} $errMsg]
  315. test file-15.8 {error conditions} {
  316.     list [catch {file s x} msg] $msg
  317. } [format {1 {bad option "s": %s}} $errMsg]
  318. test file-15.9 {error conditions} {
  319.     list [catch {file t x} msg] $msg
  320. } [format {1 {bad option "t": %s}} $errMsg]
  321. test file-15.10 {error conditions} {
  322.     list [catch {file rootname ~woohgy} msg] $msg
  323. } {1 {user "woohgy" doesn't exist}}
  324.  
  325. exec chmod 777 dir.file
  326. exec rm dir.file/gorp.file gorp.file
  327. exec rmdir dir.file
  328.